SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00028 PRINTING/PRINTER MANAGEMENT ROUTINES 1 05-28-9313:55ALL SWAG SUPPORT TEAM HP-ENVLP.PAS IMPORT 77 {In a following message, the Complete Turbo Pascal source code For DJENV.PASπis presented For all who may be interested in what it does, or illustrates.ππThe Program prints the "return" and "to:" addresses on a long ("#10")πbusiness sized envelope in a HP DeskJet series Printer.ππAlong the way it illustrates:ππ 1) How to test For existence of a specific Fileππ 2) How to Read from a structured-Type Fileππ 3) How to Write to a structured-Type Fileππ 4) How to do Text-Type output to any of: LPT1...LPT3, NUL, or a disk Fileπ With the same code.ππ 5) How to change fonts in PCL 3 (although this is not explained, it isπ done to give small print For the return address and larger printπ For the to: address.)ππ 6) How to use TechnoJock's Turbo toolkit For "full-screen I/O". There areπ three Procedures in the Program which REQUIRE the toolkit to Compile.π These routines could be modified For non-Full-Screen action whichπ would allow you to not use the TT toolkit. if you don't want to makeπ the modifications, and don't have the TT toolkit, you may File requestππ DJENV.ZIPππ from my system at 1:106/100. It has both the source code presented hereπ and a Compiled .EXE File, ready to roll.ππ if you'd like to play With it, but don't have a DJ or LASERJET-CompatibleπPrinter, then you may tell the Program to print to a disk File or even NULπinstead of LPT1, etc.ππ Whatever addresses you enter, plus the name of the "print device" youπuse, will be saved in the File DJENV.CFG . With a little work, DJENV.CFGπcould easily become a mini-database and allow you to retrieve from anyπnumber of previous envelope setups, instead of just the last one you used.πI may eventually do this, but no time frame is currently anticipated Forπit's Completion.ππ You may print 1 to many copies of the setup after you have entered it'sπinfo. The Program paUses beFore each envelope and gently nudges you toπprepare an envelope For printing and then to hit Return. (Any keyπreturning a key code will do as well as Return.)ππ Loading the envelopes is a Complete MANUAL operation. While the DJπhas a software command to load envelopes, you must still manuallyπposition the envelope For loading. if the envelope doesn't load cleanlyπ(and in my experience, about 1 in every 10 or 15 will go in crooked...), Iπfelt it would be better to deal With that BEForE attempting to print. Afterπthe envelope is in position to load, then it is necessary to hit two of theπpanel buttons together to have the DJ500 to pull the envelope intoπposition. When that is acComplished correctly, then hit Return to print toπthe envelope.ππHope some of you find this useful/interesting/maybe even helpful!π}ππProgram DJ_Envelopes;ππ{ This Program illustrates how to Program For envelope printingπ With the HP DeskJet series of Printer. It would possibly workπ For any PCL 3 (or better) Printer which can load envelopes.ππ note: Loading envelopes on the DJ Printers *IS* a bit trickyπ and requires cooperative envelopes. Be sure to read theπ part in your manual about use of envelopes, selecting goodπ Printer-use envelopes, and especially about LOADinG themπ manually. I have used the following inexpensive envelopesπ With some degree of success. They were purchased at aπ discount business/office supply store, BIZMART, but as theπ brand is national, you can probably find them most anywhere:ππ MEAD Management Series, no. 75604π Number 10 size, 4-1/8" x 9-1/2"π BARCODE# 43100 75064ππ (100 of them cost about $2.00)πππ This Program is PUBLIC doMAin and may be freely distributed, modified,π even SOLD. (if you can find somebody stupid enough to pay For a PDπ Program, MorE POWER to YOU! I would ask that you at least send meπ their names....)ππ The author is: Justin Marquez FidoNet 1:106/100 Houston, TX USAπ}ππUsesπ FASTTTT5, {Requires TechnoJock's Turbo toolkit Ver 5 or higher }π WinTTT5, {Requires TechnoJock's Turbo toolkit Ver 5 or higher }π IOTTT5, {Requires TechnoJock's Turbo toolkit Ver 5 or higher }π Crt, { Crt Unit For ClrScr }π Dos; { Req'd to be able to use the EXIST Procedure as I wrote it }ππConstπ Return_Size = #27+'&l0O'+ #27+'(10U' +#27+'(s1p6v0s41010bt2Q';π Addressee_Size = #27+'&l0O'+ #27+'(10U' +#27+'(s1p12v0s4103b1t2Q';π Config_File = 'DJENV.CFG';ππTypeπ Add_Strg = String[60];ππ Address_Data = Record { this is the Format of the "config File" }π Who_from: Array[1..5] of Add_Strg;π Last_to : Array[1..5] of Add_Strg;π PRN_DEV : String;π end;ππVarπ Return_Address,π Address : Array[1..5] of Add_Strg;ππ lst : Text;ππ Last_Data : Address_Data;π CF_Data : File of Address_Data; { going to be the config File }ππ Print_to: String;ππ n,π Counter,π How_Many : Integer;ππFunction EXIST(Filename :String): Boolean;π{ Determines if a File exists or not. NO WILDCARDS!π Main Program or Unit MUST have "Uses Dos;" in it!π}πVarπ Attr : Word;π f : File;πbeginπ Assign(f,Filename);π GetFAttr(f,Attr);π if Attr = 0 thenπ Exist := False elseπ Exist := True;πend; { of exist Function }ππProcedure DrawScreen1;π {Requires TechnoJock's toolkit, Used to set up For the full-screen I/O}πbeginπ ClrScr;π WriteCenter(1,Blue,White,' Enter Address Info, and hit F10 when done ...');π WriteCenter(2,Blue,White,' (Use CURSor keys For up & dn, RETURN For left &πright) ');π WriteAt( 1, 5, White,Blue,'RETURN ADDRESS inFO...');π WriteAt( 3, 6, White,Blue,' Line #1 :');π WriteAt( 3, 7, White,Blue,' Line #2 :');π WriteAt( 3, 8, White,Blue,' Line #3 :');π WriteAt( 3, 9, White,Blue,' Line #4 :');π WriteAt( 3,10, White,Blue,' Line #5 :');π WriteAt( 1,13, White,Blue,'ADDRESSEE inFO .... ');π WriteAt( 3,14, White,Blue,' Line #1 :');π WriteAt( 3,15, White,Blue,' Line #2 :');π WriteAt( 3,16, White,Blue,' Line #3 :');π WriteAt( 3,17, White,Blue,' Line #4 :');π WriteAt( 3,18, White,Blue,' Line #5 :');π WriteAt( 3,20, White,Blue,'Send Output to :');π WriteAt( 3,21, White,Blue,'[ Ex: LPT1 or LPT2 or NUL (For testing) ]');π WriteAt( 3,23, White,Blue,'Print How Many?:');πend; { of pvt Procedure drawscreen1 }ππProcedure FS_IO;π{ Requires TechnoJock's Turbo toolkit }πVarπ counter : Integer;πbeginπ Create_Fields(12);π { # U D L R x y }π Add_Field( 1,12, 2,12, 2,27, 6);π Add_Field( 2, 1, 3, 1, 3,27, 7);π Add_Field( 3, 2, 4, 2, 4,27, 8);π Add_Field( 4, 3, 5, 3, 5,27, 9);π Add_Field( 5, 4, 6, 4, 6,27,10);π Add_Field( 6, 5, 7, 5, 7,27,14);π Add_Field( 7, 6, 8, 6, 8,27,15);π Add_Field( 8, 7, 9, 6, 9,27,16);π Add_Field( 9, 8,10, 8,10,27,17);π Add_Field(10, 9,11, 9,11,27,18);π Add_Field(11,10,12,10,12,27,20);π Add_Field(12,11, 1,11, 1,27,23);ππ For n := 1 to 5 DoππString_Field(n,Return_Address[n],'**********************************************π****');π For n := 1 to 5 DoππString_Field(n+5,Address[n],'**************************************************'π);ππString_Field(11,Print_to,'**************************************************');π Integer_Field(12,How_Many,'',0,0);π PROCESS_inPUT(1);π Dispose_Fields;πend; { of Procedure FS_IO }ππProcedure Init;πbeginπ if ParamCount < 1π thenπ Print_to := 'LPT1'π elseπ Print_to := ParamStr(1);π if Exist(config_File)π thenπ beginπ Assign(CF_Data,ConFig_File); { How to READ a Record from a File }π ReSet(CF_Data);π Seek(CF_Data,0);π Read(CF_DATA,Last_Data);π Close(CF_Data);π With Last_Data doπ beginπ For n := 1 to 5 doπ beginπ Return_Address[n] := Who_From[n] ;π Address[n] := Last_to[n];π end;π Print_to := PRN_DEV;π end;π endπ elseπ beginπ Return_Address[1] :='';π Return_Address[2] :='';π Return_Address[3] :='';π Return_Address[4] :='';π Return_Address[5] :='';π Address[1] := '';π Address[2] := '';π Address[3] := '';π Address[4] := '';π Address[5] := '';π end;π How_Many := 1;πend;ππProcedure OutPut_to_DJ500;πbeginπ Assign(lst,Print_to);π ReWrite(lst);π Write(Lst,#27+'&l8D');π Write(lst,Return_Size);π For n := 1 to 5 Doπ WriteLn(lst,Return_Address[n]);π Write(Lst,#27+'&l5D');π Write(lst,Addressee_Size);π For n := 1 to 3 Do Writeln(lst);π For n := 1 to 5 Doπ WriteLn(lst,'π ',Address[n]);π WriteLn(lst,#12);π WriteLn(lst,#27+'E');π close(lst)πend;ππProcedure Save_Config_File;πbeginπ Assign(CF_Data,ConFig_File); { How to Write a Record to a File }π ReWrite(CF_Data);π With Last_Data doπ beginπ For n := 1 to 5 doπ beginπ Who_From[n] := Return_Address[n];π Last_to[n] := Address[n];π end;π PRN_DEV := Print_to;π end;π Seek(CF_Data,0);π Write(CF_DATA,Last_Data);π Close(CF_Data);πend;ππProcedure Pause;π{ Requires TechnoJock's Turbo toolkit }πbeginπ TempMessageBOX(20,10,Green,Blue,2,'Load an envelope (manually) and HitπRETURN.');πend;ππProcedure PRinT_ENVELOPES;πbeginπ ClrScr;π GotoXY(2,1);π Write('Printing Envelope #:');π Counter := 1;π if How_Many > 1π thenπ beginπ For Counter := 1 to How_Many Doπ beginπ WriteLn(' ',Counter);π Pause;π OutPut_to_DJ500;π end;π endπ elseπ beginπ WriteLn(' ',Counter,' ( and only 1 ...)');π Pause;π OutPut_to_DJ500;π end;πend;ππbeginπ Init;π DrawScreen1;π FS_IO;π PRinT_ENVELOPES;π Save_Config_File;πend.π 2 05-28-9313:55ALL SWAG SUPPORT TEAM LJ-G-TST.PAS IMPORT 4 Usesπ Graph, Crt, kasutils,ljGraph;ππVar gd,gm : Integer;π y0,y1,y2,x1,x2 : Integer;πbeginπ egavga_exe;π gd := detect;π InitGraph(gd,gm,'');π setcolor(10);π line(50,100,431,242);π setcolor(blue);π Y0 := 10;π Y1 := 60;π Y2 := 110;π X1 := 10;π X2 := 50;π Bar3D(X1, Y0, X2, Y1, 10, topOn);π Bar3D(X1, Y1, X2, Y2, 10, topoff);π printpause(False);π readln;π closeGraph;πend. 3 05-28-9313:55ALL SWAG SUPPORT TEAM LJ-GRAPH.PAS IMPORT 62 { PW> Does anyone have any code or info on how to Program Graphics on an HPπ PW> Laserjet?ππ--------------<start here >------------π}ππUnit LJGraph;π{$F+,O+}πInterfaceππConstπ PorTRAIT =0;π LandSCAPE =1;π GRAYSCALE =2;ππVarπ SCRNIMAGE :Pointer;π NEGATIVE :Boolean;π PROMPTPOS :Integer;π GraphDRIVER,GraphMODE:Integer;ππProcedure PRinTPAUSE(inVERT:Boolean);ππImplementationππUses Graph,Printer,Crt;ππ Procedure PROMPTLinE(MSG:String);π Varπ CHRHT,π MAXX,π MAXY :Integer;πππ beginπ MAXX:=GETMAXX;π MAXY:=GETMAXY;π SETCOLor(BLACK);π SETTextSTYLE(DEFAULTFONT,HorIZDIR,1);π SETTextJUSTifY(CENTERText,toPText);π CHRHT:=TextHEIGHT('H');π PROMPTPOS:=MAXY-(CHRHT+4);π GETMEM(SCRNIMAGE,IMAGESIZE(0,PROMPTPOS,MAXX,MAXY));π GETIMAGE(0,PROMPTPOS,MAXX,MAXY,SCRNIMAGE^);π BAR(0,PROMPTPOS,MAXX,MAXY);π RECTANGLE(0,PROMPTPOS,MAXX,MAXY);π OUTTextXY(MAXX div 2,MAXY-(CHRHT+2),MSG);π end;ππ Function FMT(MSGPOS:Real):Integer;π Varπ WIDTH :Integer;ππ beginπ WIDTH:=6;π if(MSGPOS<1000.0)thenπ DEC(WIDTH);π if(MSGPOS<100.0)thenπ DEC(WIDTH);π if(MSGPOS<10.0)thenπ DEC(WIDTH);π FMT:=WIDTH;π end;ππ Function SETGRAYSCALE(SCANLinE,GPIXEL:Integer):Integer;π Varπ GRAY :Integer;ππ beginπ GRAY:=0;π if(GraphDRIVER=CGA) and(GraphMODE<>CGAHI)thenπ beginπ Case SCANLinE ofπ 0:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 9;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 6;π end;π 1:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 4;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 11;π end;π 2:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 2;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 13;π end;π 3:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 9;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 6;π end;π end;π endπ elseπ beginπ Case SCANLinE ofπ 0:π beginπ if GPIXEL and 4<>0 thenπ GRAY:=GRAY or 5;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 10;π end;π 1:π beginπ if GPIXEL and 1<>0 thenπ GRAY:=GRAY or 2;π if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 8;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 5;π end;π 2:π beginπ if GPIXEL and 4<>0 thenπ GRAY:=GRAY or 5;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 10;π end;π 3:π beginπ if GPIXEL and 2<>0 thenπ GRAY:=GRAY or 2;π if GPIXEL and 8<>0 thenπ GRAY:=GRAY or 5;π end;π end;π end;π if NEGATIVE thenπ GRAY:=GRAY xor $0F;π SETGRAYSCALE:=GRAY;π end;ππ Procedure LJGraphIC(MODE:Integer);π Constπ ESC =#$1B;π GRendS =ESC+'*rB';π GRinIT =ESC+'E'+ESC+'&11H'+ESC+π '&10'+ESC+'*pOY'+ESC+'*t';ππ Varπ I,π J,π K,π P,π Q,π M,π MAXX,π MAXY :Integer;π XASP,π YASP :Word;π XPRN,π YPRN,π PRSTEP,π ASPR :Real;ππ beginπ PUTIMAGE(0,PROMPTPOS,SCRNIMAGE^,COPYPUT);π MAXX:=GETMAXX+1;π MAXY:=GETMAXY+1;π GETASPECTRATIO(XASP,YASP);π ASPR:=XASP/YASP;π SETVIEWPorT(0,0,MAXX,MAXY,False);π Case MODE ofπ PorTRAIT:π beginπ XPRN:=690.0;π YPRN:=500.0;π PRSTEP:=7.2/ASPR;π Write(LST,GRinIT,'100R');π For J:=0 to MAXY doπ beginπ Write(LST,ESC,'&A',π XPRN:FMT(XPRN):1,'h',π YPRN:FMT(YPRN):1,'V');π YPRN:=YPRN+PRSTEP;π Write(LST,ESC,'*r1A',ESC,'*b',MAXX div 8,'W');π For I:=0 to MAXX div 8 doπ beginπ M:=0;π For K:=0 to 7 doπ beginπ M:=M SHL 1;π if GETPIXEL(I*8+K,J)<>0 thenπ inC(M);π end;π Write(LST,Char(M));π end;π Write(LST,GRendS);π end;π end;π LandSCAPE:π beginπ XPRN:=1000.0;π YPRN:=1000.0;π PRSTEP:=9.6*ASPR;π Write(LST,GRinIT,'75R');π For J:=0 to MAXX-1 doπ beginπ Write(LST,ESC,'&a',π XPRN:FMT(XPRN):1,'h',π YPRN:FMT(YPRN):1,'V');π YPRN:=YPRN+PRSTEP;π Write(LST,ESC,'*r1A',ESC,'*b',MAXX div 8,'W');π For I:=0 to MAXY div 8 doπ beginπ M:=0;π For K:=0 to 7 doπ beginπ M:=M SHL 1;π if GETPIXEL(MAXX-J-1,I*8+K)<>0 thenπ inC(M);π end;π Write(LST,Char(M));π end;π Write(LST,GRendS);π end;π end;π GRAYSCALE:π beginπ XPRN:=1000.0;π YPRN:=1000.0;π PRSTEP:=2.4*ASPR;π Write(LST,GRinIT,'300R');π For J:=0 to MAXX doπ For P:=0 to 3 doπ beginπ Write(LST,ESC,'&a',π XPRN:FMT(XPRN):1,'h',π YPRN:FMT(YPRN):1,'V');π YPRN:=YPRN+PRSTEP;π Write(LST,ESC,'*r1A',ESC,'*b',MAXY div 2,'W');π For I:=0 to MAXY div 2 doπ beginπ M:=0;π For K:=0 to 1 doπ beginπ M:=M SHL 4;π M:=M or SETGRAYSCALE(P,GETPIXEL(MAXX-J,I*2+K));π end;π Write(LST,Char(M));π end;π Write(LST,GRendS);π end;π end;π end;π Write(LST,#$0C,ESC,'&10',ESC,'(8U',ESC,'(sp10h12vsb0T',ESC,'&11H');π end;πππ Procedure PRinTPAUSE(inVERT:Boolean);π Varπ CH :Char;π doNE :Boolean;ππ beginπ DETECTGraph(GraphDRIVER,GraphMODE);π doNE:=False;π NEGATIVE:=inVERT;π While not doNE doπ beginπ PROMPTLinE('PRESS THE <P> KEY to PRinT THIS Graph '+π 'or ANY OTHER to Exit....');π While KeyPressed doπ CH:=ReadKey;π CH:=ReadKey;π PUTIMAGE(0,PROMPTPOS,SCRNIMAGE,COPYPUT);π Case UPCase(CH)ofπ 'P':π beginπ LJGraphIC(GRAYSCALE);π doNE:=True;π end;π elseπ doNE:=True;π end;π DISPOSE(SCRNIMAGE);π end;π end;πend.π{π---------- stop here --------πSo first you init the Graph driver. Next you draw the Graph you want. thenπyou use printpause afterwards you can close the Graphdriver.π} 4 05-28-9313:55ALL SWAG SUPPORT TEAM LJ-GRPH2.PAS IMPORT 18 >Does anyone have any code or info on how to print Graphics on an HPπ>Laserjet?ππ The best thing to do would be to purchase the Technical ReferenceπManual through HP Support Materials (800)227-8164. (I don't know if thisπis an international number since you are in Canada) I don't own aπLaserJet, but own a DeskJet and my manual sold For $21.95. They go intoπgreat detail on the codes For all of the Text and Graphic Functions.ππ There are some books on Laser Printer Graphics you could find in aπbigger public library or university library that would be helpfulπalso.ππ Here are a few minor HP-PCL5 commands that will give you someπcapabilities to tie you over (They refer to this as Raster GraphicπMode):ππ I will give these codes in hex, if you need another Format let me know )ππ Start Raster Graphicsπ At leftmost position 1B 2A 72 30 41π At current cursor position 1B 2A 72 31 41ππ end Raster Graphics 1B 2A 72 62 43ππ Select Resolutionπ 75 D.P.I. 1B 2A 74 37 35 52π 100 D.P.I. 1B 2A 74 31 30 30 52π 150 D.P.I. 1B 2A 74 31 35 30 52π 300 D.P.I. 1B 2A 74 33 30 30 52ππ Transfer Raster Graphicsπ Number of Bytes 1B 2A 62 #of Bytes to send# 57 #data#ππ Raster Graphics can be thought of as being a one pin dot matrixπPrinter to an extent... think of it as drawing a horizontal line inπbinary:π 11111111 +------+π 10000001 -> | |π 11111111 +------+ππwould be:π 1B 2A 72 30 41π 1B 2A 74 31 30 30 52π 1B 2A 62 01 57 FFπ 1B 2A 62 01 57 81π 1B 2A 62 01 57 FFπ 1B 2A 72 62 43ππat 100 DPI For example.ππ My apologies to the moderator if this is off topic, I understand theπfrustration resulting from buying a $500 (or $2500 in the Case of theπLaserJet) Printer and not being able to do squat With it Until you canπfind the inFormation they should have put in the user's manual in theπfirst place! (8->) Daveππ 5 05-28-9313:55ALL SWAG SUPPORT TEAM LP.PAS IMPORT 33 { The following Program, LPRINT, illustrates how to do control a }π{ Printer directly without using the BIOS (Printers connected to }π{ the parallel port, not serial Printers connected to an RS-232 }π{ port). }π{ LPRINT checks to see if you want to print a line from the command }π{ prompt, as in: }π{ LPRINT Hello, World! }π{ If there's no command input, LPRINT checks For Characters at the }π{ "standard input," so you can print Files or directories using }π{ redirection or piping: LPRINT < myFile.pas }π{ DIR | LPRINT }π{ LPT1 is used. You can modify LPRINT to use another, or be able to }π{ specify which Printer via the command line (eg. /2 For LPT2,etc.) }π{ This source code is a bit cramped, to fit into one message. }π{ }ππProgram LPRINT;πUsesπ Dos;πConstπ BusyB =$80; { status port 'busy' bit }π AckB =$40; { status port 'ack' bit }πVarπ DataP,π Strobe,π Status, { assigned lpt i/o ports }π MaxWait : Word; { seconds before timing out }π Done : Boolean; { sanity clause }π Reg : Registers; { For Dos i/o }π txtptr : Byte; { counter Byte }ππProcedure VerifyPrinter( Var Printer, Status, Strobe : Word );π{ check For presence of specified Printer - returning ports }πbeginπ if Printer in [1..3] then { must be known }π beginπ DEC( Printer ); { For 0..2 }π Printer := MemW[$40 : (Printer + 8 + Printer * 2)];π if ((Port[Printer + 1] and AckB) = 0) thenπ Printer := 0 { to say it's not there }π elseπ beginπ Status := Printer + 1;π Strobe := Printer + 2;π endπ endπend; {VerifyPrinter}ππProcedure Print( DataP : Word; chout : Byte; Var Done : Boolean);π{ send Character to Printer port, With busy timeout and feedback }πVarπ WaitTime : LongInt;π Timer : LongInt Absolute 0:$046c;π BusyWait : Word;πbeginπ BusyWait := 0;π WaitTime := Timer;π While ((Port[Status] and BusyB) = 0) and (BusyWait < MaxWait * 19) doπ { wait up to MaxWait seconds For non-busy state }π BusyWait := Word( Timer - WaitTime );π if BusyWait >= (MaxWait * 19) then { Printer "busy" For too long? }π Done := False { failed }π elseπ beginπ Port[DataP] := chout; { send the Char data}π Port[Strobe] := $0c; { strobe it in }π Port[Strobe] := $0d; { reset strobe }π Done := True; { success }π end {else}πend; {Print}ππbegin {LPRINT}π WriteLn(#10, 'LPRINT v1.0 G.S.Vigneault', #10);π DataP := 1; { LPT1 }π VerifyPrinter( DataP, Status, Strobe );π { DataP will be 0 now if requested Printer didn't respond }π if DataP = 0 thenπ beginπ WriteLn('Printer not detected!',#10,#7);π Halt(1);π end;π MaxWait := 10; { max wait 10sec before timing out lpt }π if ParamCount = 0 then { no command-line input? }π { handle redirected and piped }π Repeatπ Reg.AH := $b; { to see if a Char is available }π MsDos( Reg );π if Reg.AL <> 0 thenπ beginπ Reg.AH := 8; { get the Char }π MsDos( Reg ); { via Dos }π Print( DataP, Reg.AL, Done );{ lprint it }π end; {if}π Until (Reg.AL = 0) or not Doneπ else { print the command line Text }π beginπ txtptr := $82;π Repeatπ Print( DataP, Mem[PrefixSeg:txtptr], Done );π INC( txtptr );π Until (Mem[PrefixSeg:txtptr] = 13) or not Done;π if Done thenπ Print( DataP, 10, Done); { lf }π end;πend {LPRINT}.π(********************************************************************)π 6 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER.PAS IMPORT 53 {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π{Allow overlays}π{$F+,O-,X+,A-}π{$ENDIF}ππ{$DEFINE AssignLstDevice}ππUNIT Printer;ππINTERFACEππCONSTππ fmClosed = $D7B0; { magic numbers for Turbo }π fmInput = $D7B1;π fmOutput = $D782;π fmInOut = $D7B3;ππ IO_Invalid = $FC; { invalid operation eg. attempt to write }π { to a file opened in fmInput mode }ππ LPTNames : ARRAY [0..2] OF STRING [4] = ('LPT1', 'LPT2', 'LPT3');ππ LPTPort : BYTE = 0;ππVARπ Lst : TEXT; { for source compatability with TP3 }ππFUNCTION GetROMPrinterStatus (LPTNo : WORD) : BYTE;π { status of LPTNo via ROM BIOS int 17h func 2h }π INLINE (π $5A / { pop DX ; get printer number}π $B4 / $02 / { mov AH,02 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππFUNCTION DoInt17 (Ch : CHAR; LPTNo : WORD) : BYTE;π { send a character to LPTNo via ROM BIOS int 17h func 0h }π INLINE (π $5A / { pop DX ; get printer number}π $58 / { pop AX ; get char}π $B4 / $00 / { mov AH,00 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππPROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππPROCEDURE OutputToFile (FName : STRING);π {redirect printer output to file }ππFUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;ππFUNCTION Printer_OK : BOOLEAN;ππPROCEDURE SelectPrinter (LPTNum : BYTE);ππPROCEDURE ResetPrinter; { only resets printer 0 }ππIMPLEMENTATIONππTYPEπ TextBuffer = ARRAY [0..127] OF CHAR;ππ TextRec = RECORDπ Handle : WORD;π Mode : WORD;π BufSize : WORD;π Private : WORD;π BufPos : WORD;π BufEnd : WORD;π BufPtr : ^TextBuffer;π OpenFunc : POINTER;π InOutFunc : POINTER;π FlushFunc : POINTER;π CloseFunc : POINTER;π { 16 byte user data area, I use 4 bytes }π PrintMode : WORD; { not currently used}π LPTNo : WORD; { LPT number in [0..2] }π UserData : ARRAY [1..12] OF CHAR;π Name : ARRAY [0..79] OF CHAR;π Buffer : TextBuffer;π END;πCONSTπ LPTFileopen : BOOLEAN = FALSE;ππVARπ LPTExitSave : POINTER;ππ PROCEDURE Out_Char (Ch : CHAR; LPTNo : WORD; VAR ErrorCode : INTEGER);π { call macro to send char to LPTNo. If bit 4, the Printer Selected bit }π { is not set upon return, it is assumed that an error has occurred. }ππ BEGINπ ErrorCode := DoInt17 (Ch, LPTNo);π IF (ErrorCode AND $10) = $10 THEN { if bit 4 is set }π ErrorCode := 0 { no error }π { if bit 4 is not set, error is passed untouched and placed in IOResult }π END;ππ FUNCTION LstIgnore (VAR F : TextRec) : INTEGER;π { A do nothing, no error routine }π BEGINπ LstIgnore := 0 { return 0 for IOResult }π END;ππ FUNCTION LstOutput (VAR F : TextRec) : INTEGER;π { Send whatever has accumulated in the Buffer to int 17h }π { If error occurs, return in IOResult. See Inside Turbo }π { Pascal chapter of TP4 manual for more info on TFDD }π VARπ I : WORD;π ErrorCode : INTEGER;ππ BEGINπ LstOutput := 0;π WITH F DO BEGINπ FOR I := 0 TO PRED (BufPos) DO BEGINπ Out_Char (BufPtr^ [I], LPTNo, ErrorCode); { send each char to printer }π IF ErrorCode <> 0 THEN BEGIN { if error }π LstOutput := ErrorCode; { return errorcode in IOResult }π EXIT { return from function }π ENDπ END;π BufPos := 0π END;π END;ππ PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππ BEGINπ WITH TextRec (F) DOπ BEGINπ Mode := fmClosed;π BufSize := SIZEOF (Buffer);π BufPtr := @Buffer;π OpenFunc := @LstIgnore; { you don't open the BIOS printer functions }π CloseFunc := @LstIgnore; { nor do you close them }π InOutFunc := @LstOutput; { but you can Write to them }π FlushFunc := @LstOutput; { and you can WriteLn to them }π LPTNo := LPTNumber; { user selected printer num (in [0..2]) }π MOVE (LPTNames [LPTNumber], Name, 4); { set name of device }π BufPos := 0; { reset BufPos }π END;π END;ππ PROCEDURE OutputToFile (FName : STRING);π BEGINπ ASSIGN (Lst, FName);π REWRITE (Lst);π LPTFileopen := TRUE;π END;ππ FUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;π VARπ Status : BYTE;π BEGINπ Status := GetROMPrinterStatus (LPTNum);π IF (Status AND $B8) = $90 THENπ PrinterStatus := 0 {all's well}π ELSE IF (Status AND $20) = $20 THENπ PrinterStatus := 1 {no Paper}π ELSE IF (Status AND $10) = $00 THENπ PrinterStatus := 2 {off line}π ELSE IF (Status AND $80) = $00 THENπ PrinterStatus := 3 {busy}π ELSE IF (Status AND $08) = $08 THENπ PrinterStatus := 4; {undetermined error}π END;ππ FUNCTION Printer_OK : BOOLEAN;π VARπ Retry : BYTE;π BEGINπ Retry := 0;π WHILE (PrinterStatus (LPTPort) <> 0) AND (Retry < 255) DO INC (Retry);π Printer_OK := (PrinterStatus (LPTPort) = 0);π END; {PrinterReady}ππ PROCEDURE SelectPrinter (LPTNum : BYTE);π BEGINπ IF (LPTNum >= 0) AND (LPTNum <= 3) THENπ LPTPort := LPTNum;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);π END;ππ PROCEDURE ResetPrinter;π VARπ address : INTEGER ABSOLUTE $0040 : $0008;π portno, DELAY : INTEGER;π BEGINπ portno := address + 2;π Port [portno] := 232;π FOR DELAY := 1 TO 2000 DO {nothing} ;π Port [portno] := 236;π END; {ResetPrinter}ππ PROCEDURE LptExitHandler; FAR;π BEGINπ IF LPTFileopen THEN CLOSE (Lst);π ExitProc := LPTExitSave;π END;ππBEGINππ LPTExitSave := ExitProc;π ExitProc := @LptExitHandler;ππ {$IFDEF AssignLstDevice}ππ LPTPort := 0;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);ππ {$ENDIF}ππEND.π 7 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER1.PAS IMPORT 18 {πI am writing a Program that Uses the Printer to (whatelse?) printπout a report. Now, the problem that I am having is that the PrinterπFunction in TP 6.0 (ie Writeln (lst,'BLA BLA BLA');) Dosn'tπcheck For errors (if the Printer is not on, or is not online)πbasicaly I need something that weill check and give out theπfamous line ('Printer not Ready (A)bort (R)etry')πππYour're in luck, I just got a new Printer and started writing routines toπcontrol it (TFDD etc..). These are probably the most important ones:ππππ{ note: This routines are not throughly tested on Various Printers.}π{ Thus it may of may not work on your Type of Printer. }π{ But, as a rule, experiment With it and have fun............}ππUsesπ Dos;ππFunctio PrinterOutofPaper( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ Regs.AH := $02;π Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs); { Print Service Please }π PrinterOutofPaper := (Regs.AH and $20 = $20)πend;ππFunction PrinterReady( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AH := $02;π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs)π PrinterReady := (AH and $80 = $80) and { Printer Busy? }π (AH and $10 = $10) and { Printer Online? }π (AH and $08 = $00) { Printer Error? }π end;πend;ππProcedure PrintChar(Port: Byte; Ch: Char);πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AL := ord(Ch); { Char to print }π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π AH := $00; { Print Char Service }π Intr($17, Regs); { Call Bios }π endπend;ππProcedure BootPrinter( Port: Byte);π { Initializes IBM- or EPSON- Compatible Printer }π { Other Printers may not understand this command }π { and may produce unwanted results }πVarπ Regs : Registers;πbeginπ Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Regs.AH := $01;π Intr($17, Regs)πend;π 8 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER2.PAS IMPORT 17 {πI am looking For something like in BASIC where you could ON ERRO GOSUBπand anytime there was an error the Program re-routed..ππIt Sounds like you're after two things; a method of checking your Printerπand a means of trapping runtime errors.π}πFunction PrinterReport:Byte;π{ This Function requires the Dos Unit. Returned values mean the following -π 0 = Printer is okayπ 1 = Printer is out of paperπ 2 = Printer is offlineπ 3 = Printer is busyπ 4 = God knows what's wrong With the Printer but I'd get an engineer out.}πVarπ Regs : Registers;πbeginπ With Regs doπ beginπ Ah := 2;π Dx := LPTport;π intr($17,Regs);π if (Ah and $B8) = $90 then PrinterReport := 0π else if (Ah and $20) = $20 then PrinterReport := 1π else if (Ah and $10) = $00 then PrinterReport := 2π else if (Ah and $80) = $00 then PrinterReport := 3π else if (Ah and $08) = $08 then PrinterReport := 4;π end;πend; { of Function }ππ{πAs For trapping runtime errors, all you have to do is replace theπstandard Exit Procedure With your own. For example...π}ππProgram JohnMajorGoosedTheCook;πVarπ SavedExitPoint : Pointer; { This holds the old Exit proc value }π Number : Integer;ππ{$F+}πProcedure MyExitProc;π{$F-}πbeginπ if errorAddr <> NIL then { if you got a runtime error... }π beginπ Writeln ('The Programmer got it wrong again. There has been an');π Writeln ('error at ',seg(errorAddr^), ':', ofs(errorAddr^));π Writeln ('with an Exit code of ',exitCode);π Writeln ('Please call him on 123-4567 and give him dogs abuse.');π errorAddr := NIL; { which cancels the runtime error address...}π ExitCode := 0; { which cancels the runtime error code }π end;π Exitproc := SavedExitPoint; { restore the old Exit Procedure...}πend; { of Procedure }ππbeginπ SavedExitPoint := ExitProc; { Save the old Exit Procedure... }π ExitProc := @MyExitProc; { ...and replace it With your own }π Number := 0; { Uh oh... }π Writeln (4 div Number); { Oh dear...}πend. { of PROGRAM }π 9 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER3.PAS IMPORT 19 Unit Myprint;π{$D-,I-,S-}πInterfaceππUses Dos;ππVarπ Prt : Array[1..2] of Text;π Lst : Text Absolute Prt;ππFunction PrinterStatus(p: Byte): Byte;πFunction PrinterReady(Var b : Byte; p: Byte): Boolean;ππImplementationππProcedure RawMode(Var L); { make sure that device is in raw mode }π Varπ regs : Registers;π beginπ With regs do beginπ bx := TextRec(L).Handle; { place the File handle in bx }π ax := $4400; { setup For Function $44 sub-Function 0 }π MSDos(regs); { execute Dos Function }π dl := dl or $20; { bit 5 = raw mode }π dh := 0; { set dh to zero }π ax := $4401; { setup For Function $44 sub-Function 1 }π MSDos(regs) { execute Dos Function }π end; { With }π end; { RawMode }ππFunction PrinterStatus(p: Byte): Byte;π { Returns the Printer status. LPT1=p=1, LPT2=p=2 }π Var regs : Registers; { from the Dos Unit }π beginπ With regs do beginπ dx := p - 1; { The Printer number }π ax := $0200; { The Function code For service wanted }π intr($17,regs); { $17= ROM bios int to return Printer status}π PrinterStatus := ah;{ Bit 0 set = timed out }π end; { 1 = unused }π end; { 2 = unused }π { 3 = I/O error }π { 4 = Printer selected }π { 5 = out of paper }π { 6 = acknowledge }π { 7 = Printer not busy }ππFunction PrinterReady(Var b : Byte; p: Byte): Boolean;π beginπ b := PrinterStatus(p);π PrinterReady := (b = $90) { This may Vary between Printers }π end;ππbeginπ assign(Prt[1],'LPT1');π reWrite(Prt[1]);π RawMode(Prt[1]);π assign(Prt[2],'LPT2');π reWrite(Prt[2]);π RawMode(Prt[2]);πend.ππ 10 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER4.PAS IMPORT 38 (*πI am trying to figure out how to trap errors as they occur in myπProgram and send messages to the user.. The most common error would be aπfailed attempt to print but I don't know how to not stop the Programπwhen an error occurrs. You see, I don't want to have an {$I-},{$I+}πafter every time the Printer prints..πππnot having any details of what you are doing, I'll take a stab in the dark.πHave an output routine and pass it a String. The output routine would takeπthe String and sent it to the Printer. ( Since you mentioned Printer, Iπassume this is where you wish to send all output.) Now have an output routineπFor the screen. Ah heck, here's an example. <g> This is some code I wrote toπoutput Various things to the Printer. No doubt some will claim to have betterπsolutions. That's fine, but here's mine. There is a routine you will seeπcalled OUTCON(s : String; CH : Char); It is a routine to send output to theπscreen and inForm the user that there is a problem. of course that's aπdifferent topic then sending output to the Printer. Hope this helps.π*)ππConstπ TimedOut = $01; { Used to determine the Type of Printer error }π IOError = $08;π OutofPaper = $20;π notBusy = $80;π TestAll = TimedOut+IOError+OutofPaper;π NoUL = False;π UL = True;ππVarπ PrnStatus : Byte;ππFunction PrinterReady : Boolean;π{ checks the status of the Printer and returns True if ready to recieve a Charaπ{ This Function will return the status of your Printer. Status }π{ should be interpreted as follows: (x'90' (d'144') is "Ready"): }π{ $01 = Printer Time-out $02 = not Used }π{ $04 = not Used $08 = I/O Error }π{ $10 = Printer Selected $20 = Out of Paper }π{ $40 = Acknowledge $80 = not Busy }πVarπ Regs : Registers;π TempStatus : Byte;πbeginπ With Regs Doπ beginπ DX := 0;π AX := $0200;π Intr($17,Regs);π PrnStatus := Hi(AX);π TempStatus := PrnStatus;π if TempStatus and TestAll = $00 then PrinterReady := Trueπ else PrinterReady := False;π end;πend; { Function PrinterReady }ππProcedure GetPrnError(Var ESC : Boolean);π{ gets the error that occured With the Printer and gives the user a chance to }π{ correct the problem and continue. }πVarπ CH : Char;πbeginπ Repeatπ PrnStatus := PrnStatus and TestAll;π Case PRnStatus ofπ TimedOut : OutCon('Printer timed out. Retry??? (Y/N)',CH);π IOError : OutCon('An IOError has occured. Retry??? (Y/N)',CH);π OutofPaper : OutCon('Printer out of paper. Retry??? (Y/N)',CH);π else OutCon('A Print Device Error has occured. Retry??? (Y/N)',CH);π end;π if CH = 'N' then esc := True;π Until ESC or PrinterReady;πend;ππFunction EscapePushed : Boolean;π{ Checks the keyboard buffer For a Character and test to see if it was the }π{ Esc key. if it was it returns True else it returns False. }πVarπ CH : Char;πbeginπ if KeyPressed then { Check the keyboard buffer For a Character }π beginπ CH := ReadKey; { if Character then check it }π CH := UpCase(CH);π if Ch = Chr(27) then EscapePushed := Trueπ else EscapePushed := False;π endπ else EscapePushed := False;πend; { EscapePushed }ππProcedure ConfirmQuit(Var ESC : Boolean);π{ confirms that the user wants to quit printing }πVarπ CH : Char;πbeginπ OutCon('Cancel all print jobs? (Y/N)',Ch);π if CH = 'Y' then ESC := Trueπ else ESC := False;πend;ππProcedure FFeed;π{ sends a Form feed command to the Printer }πbeginπ Write(LST,#12);πend;ππProcedure PrintCh(CH : Char;π Underline : Boolean;π Var OK : Boolean);π{ Writes a Single Character to the Printer }πbeginπ if UnderLine then {$I-} Write(LST, #27#45#1, CH, #27#45#0) {$I+}π else {$I-} Write(lst,CH); {$I+}π if Ioresult <> 0 then OK := Falseπ else OK := True;πend;ππProcedure WriteStr(TheStr : String;π Return, UnderLine : Boolean;π Var ESC : Boolean);πVarπ PrnReady : Boolean;π OK : Boolean;π I : Byte;πbeginπ Repeatπ PrnReady := PrinterReadyπ if not PrnReady then GetPrnError(ESC);π Until PrnReady or ESC;π I := 1;π While PrnReady and not Esc and (I <> Length(theStr)+1) doπ beginπ PrnReady := PrinterReadyπ if not PrnReady then GetPrnError(ESC);π if not ESC then PrintCh(theStr[I],UnderLine,OK);π if not esc then if EscapePushed then confirmQuit(Esc);π if OK then Inc(I);π end;π if PrnReady and not ESC and RETURN then {$I-} Writeln(LST); {$I+}πend;π 11 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER5.PAS IMPORT 8 {π EPSON Printer. I'm using TP7.0. Everythings works fine except oneπ situation that occured when a Character 26 (Ctrl-Z which is Eof) is inππThis may be the easy way out, but why not just use BIOS interrupt $17?πIt's probably slower, but it'll work.π}ππType PGraphics : ^Graphics;π Graphics : Array [1..65535] of Byte;ππFunction InitPort (PortNum : Byte) : Byte; {returns status}πVar Regs : Registers;πbeginπ Regs.DX := PortNum;π Intr ($17, Regs);π InitPort := Regs.AL;π end;ππProcedure OutStreamofStuff (PortNum : Byte; Where : PGraphics; Len : Word);πVar Count : Word; Regs : Registers;πbeginπ Regs.DX := NumPort;π For Count := 1 to Len doπ beginπ Regs.AL := ^Where[Count];π end;π end;ππInitPort returnsπ 144 Printer OKπ 24 Printer not OKπ 184 Printer is offπ 12 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER6.PAS IMPORT 12 {πI am writing a Program that Uses the Printer to (whatelse?) printπout a report. Now, the problem that I am having is that the PrinterπFunction in TP 6.0 (ie Writeln (lst,'BLA BLA BLA');) Dosn'tπcheck For errors (if the Printer is not on, or is not online)ππ You can determine the Various states of the Printer With Intr 17H -π Function 02H. The value returned in AH will be:ππ bit if setπ 0 - Printer timed outπ 1 - unusedπ 2 - unusedπ 3 - i/o errorπ 4 - Printer selectedπ 5 - out of paperπ 6 - Printer acknowledgeπ 7 - Printer not busyππ For example:π}πFunction PrinterReady : Boolean;πVarπ reg : Registers;π Status : Byte;ππbeginπ reg.AH := $02;π reg.DX := $00; {..0=LPT1, 1=LPT2, etc }π intr($17,reg);ππ Status := reg.AH and $41; {..isolate bits 0,3,5 }π if Status <> 0 thenπ PrinterReady := Falseπ elseπ PrinterReady := True;πend;ππ{πbasicaly I need something that weill check and give out theπNB>famous line ('Printer not Ready (A)bort (R)etry')ππThe way I've handled this in the past is to check PrinterReady beForeπeach Write/WriteLn statement (not very eloquant). A better way to doπthis might be to hook it to an interrupt, checking the status every fewπseconds.π} 13 05-28-9313:55ALL SWAG SUPPORT TEAM PRINTER7.PAS IMPORT 15 {Your're in luck, I just got a new Printer and started writing routines toπcontrol it (TFDD etc..). These are probably the most important ones:ππππ note: This routines are not throughly tested on Various Printers.π Thus it may of may not work on your Type of Printer.π But, as a rule, experiment With it and have fun............}ππUsesπ Dos;ππFunctio PrinterOutofPaper( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ Regs.AH := $02;π Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs); { Print Service Please }π PrinterOutofPaper := (Regs.AH and $20 = $20)πend;ππFunction PrinterReady( Port : Byte): Boolean;πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AH := $02;π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Intr($17, Regs)π PrinterReady := (AH and $80 = $80) and { Printer Busy? }π (AH and $10 = $10) and { Printer Online? }π (AH and $08 = $00) { Printer Error? }π endπend;ππProcedure PrintChar(Port: Byte; Ch: Char);πVarπ Regs : Registers;πbeginπ With Regs Doπ beginπ AL := ord(Ch); { Char to print }π DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π AH := $00; { Print Char Service }π Intr($17, Regs); { Call Bios }π endπend;ππProcedure BootPrinter( Port: Byte);π { Initializes IBM- or EPSON- Compatible Printer }π { Other Printers may not understand this command }π { and may produce unwanted results }πVarπ Regs : Registers;πbeginπ Regs.DX := Port; { 0=LPT1, 1=LPT2, 2=LPT3 }π Regs.AH := $01;π Intr($17, Regs)πend;π 14 06-22-9309:11ALL SWAG SUPPORT TEAM Write to CON and PRN IMPORT 37 UNIT ConPrnIO;π{ UNIT TO WRITE TO SCREEN AND PRINTER AT THE SAME TIME }ππINTERFACEππ USES DOS;π VARπ ConPrn : Text;ππ PROCEDURE SetLptNbr(PrinterPort: Byte);ππIMPLEMENTATIONππ VARπ IOBuffer : ARRAY[0..255] OF Char;π OldExitProc : Pointer;ππ{$F+}π PROCEDURE ExitConPrn;π BEGINπ ExitProc := OldExitProc;π Close(ConPrn)π END;ππ{------------------------------}ππ PROCEDURE SetLptNbr;ππ FUNCTION NbrLpts: Integer;π VARπ Regs : Registers;π BEGINπ Intr($11,Regs);π NbrLpts := Regs.AH SHR 6π END;πππ BEGINπ IF NbrLpts = 0 THENπ BEGINπ WriteLn('No printer port installed');π Halt(1)π END;ππ WITH TextRec(ConPrn) DOπ BEGINπ IF PrinterPort <= NbrLpts THENπ UserData[1] := PrinterPort - 1π ELSEπ UserData[1] := 0 {Default to LPT1}π ENDπ END;ππ{------------------------------}ππ FUNCTION OutPrn(VAR F: TextRec; ch : Char):π Integer;π FUNCTION GetPrnStatus(PrnPort: Byte): Boolean;ππ VARπ Regs : Registers;π NbrPasses : Byte;π CONSTπ Retries : Byte = 100;ππ BEGINππ NbrPasses := 0;π GetPrnStatus := TRUE;ππ WITH Regs DOπ BEGINπ REPEATπ AH := $02;π DX := F.UserData[1];π Intr($17,Regs);π AH := AH AND $90;π IF (AH <> $90) ANDπ (NbrPasses < Retries) THENπ Inc(NbrPasses)π UNTIL (NbrPasses > Retries) ORπ (AH = $90);π IF AH <> $90 THENπ GetPrnStatus := FALSE;π ENDπ END;πππ VARπ Regs : Registers;π ChByte : Byte;ππ BEGINπ ChByte := Ord(ch);π WITH Regs DOπ BEGINπ IF GetPrnStatus(F.UserData[1]) THENπ BEGINπ AH := $00;π AL := ChByte;π DX := F.UserData[1];π Intr($17,Regs);π OutPrn := 0;π ENDπ ELSEπ OutPrn := 160π ENDπ END;ππ{------------------------------}ππ FUNCTION InOutConPrn(VAR F: TextRec): Integer;πππ PROCEDURE OutCon(ch : Char; DspPage : Byte);π VARπ Regs : Registers;π BEGINπ Regs.AH := $0E; {Write TTY character}π Regs.AL := Byte(ch);π Regs.BH := DspPage;π Intr($10,Regs)π END;πππ VARπ OutputPos, DspPage : Byte;π Regs : Registers;π Status : Integer;ππ BEGINπ WITH F DOπ BEGINπ Regs.AH := $0F; {Get Current Display Page}π Intr($10,Regs);π DspPage := Regs.BH;π OutputPos := 0;π Status := 0;π InOutConPrn := 0;π WHILE (OutputPos < BufPos) ANDπ (Status = 0) DOπ BEGINπ OutCon(BufPtr^[OutputPos],DspPage);π Status := OutPrn(F,BufPtr^[OutputPos]);π Inc(OutputPos);π IF Status <> 0 THENπ InOutConPrn := 160;π END;π BufPos := 0;π ENDπ END;ππ{------------------------------}ππ FUNCTION FlushConPrn(VAR F: TextRec): Integer;π BEGINπ WITH F DOπ BEGINπ IF BufPos <> 0 THENπ FlushConPrn := InOutConPrn(F)π ELSEπ FlushConPrn := 0π ENDπ END;ππ{------------------------------}ππ FUNCTION CloseConPrn(VAR F: TextRec): Integer;π {print a ff on printer when closing device}π BEGINπ IF F.UserData[1] < 3 THENπ CloseConPrn := OutPrn(F,Chr(12))π END;ππ{------------------------------}ππ FUNCTION OpenConPrn(VAR F: TextRec): Integer;π BEGINπ WITH F DOπ BEGINπ IF Mode = fmOutput THENπ BEGINπ InOutFunc := @InOutConPrn;π FlushFunc := @FlushConPrn;π CloseFunc := @CloseConPrn;π FillChar(IOBuffer,SizeOf(IOBuffer),#0);π OpenConPrn := 0π ENDπ ELSEπ OpenConPrn := 104 {file not openπ for input or Append}π ENDπ END;ππ{$F-}ππ{------------------------------}πππ PROCEDURE AssignConPrn(VAR F : Text);ππ BEGINπ WITH TextRec(F) DOπ BEGINπ Mode := fmClosed;π BufSize := SizeOf(IOBuffer);π BufPtr := @IOBuffer;π OpenFunc := @OpenConPrn;π Name[0] := #0π ENDπ END;ππ{-------- UNIT INITIALIZATION SECTION ---------}πππBEGINπ AssignConPrn(ConPrn);π Rewrite(ConPrn);ππ OldExitProc := ExitProc;π ExitProc := @ExitConPrn;ππ SetLptNbr(1); {default to LPT1}πEND.ππ{ ------------------ TEST PROGRAM ------------------------}ππPROGRAM TestConPrn;πππUSES DOS,CRT,Printer,ConPrnIO;πππBEGINπ ClrScr;π WriteLn('Written to screen');π WriteLn(ConPrn,'Written to both');π WriteLn('Written to screen');π WriteLn(Lst,'Written to printer only')πEND.ππ 15 06-22-9309:21ALL SWAG SUPPORT TEAM Check for Printer Ready IMPORT 12 ===========================================================================π BBS: The Beta ConnectionπDate: 06-08-93 (20:02) Number: 819πFrom: JEFF PALEN Refer#: 777π To: DAN SABIN Recvd: YES πSubj: PRINTER CRASHING Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πDS>Does anyone know how you can check from Turbo Pascal that theπDS>printer is turned on so that you won't get a device error thatπDS>will crash a program? I can't find anything about this.ππProgram Printer_Status;πUses Dos;πFunction PrinterOnLine : Boolean;π Constπ PrnStatusInt : Byte = $17; (* Dos interrupt *)π StatusRequest : Byte = $02; (* Interrupt Function Call *)ππ PrinterNum : Word = 0; { 0 for LPT1, 1 for LPT2, etc. }π Varπ Regs : Registers ; { Type is defined in Dos Unit }ππ Begin (* PrinterOnLine*)π Regs.AH := StatusRequest;π Regs.DX := PrinterNum;π Intr(PrnStatusInt, Regs);π PrinterOnLine := (Regs.AH and $80) = $80;π End;ππBegin (* Main Program *)π If PrinterOnLine Thenπ Writeln('Ready To Print')π Elseπ Writeln('Please check the printer!');πEnd.ππ---π ■ RM 1.0 ■ Eval Day 4 ■ Programmer's do it with bytes and nybbles....π * Channel 1(R) * 617-354-7077 * Cambridge MA * 85 linesπ * PostLink(tm) v1.06 CHANNEL1 (#15) : RelayNet(tm)π 16 07-16-9306:12ALL CHRIS PRIEDE Printer Ready Function IMPORT 12 ε╡ ===========================================================================π BBS: The Beta ConnectionπDate: 07-06-93 (15:28) Number: 1525πFrom: CHRIS PRIEDE Refer#: 1378π To: PETER KIRKWOOD Recvd: NO πSubj: Printer Ready? Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------πPK> Any suggestions as to how I can check if a printer is onlineπPK>and/or ready would be appreciated.ππ Interrupt 17h service 02h returns printer status flags. We areπinterested in three:ππ bit 7 = 1 Readyπ bit 5 = 1 Out of paperπ bit 3 = 1 I/O errorπππ Bit 7 should be 1 and bits 5, 3 -- 0. You can use the followingπBASM routine to check it:ππconstπ pnLPT1 = 0;π pnLPT2 = 1;π pnLPT3 = 2;ππfunction PrinterReady(PN: word): boolean; assembler;πasmπ mov dx, PN {printer number goes in DX}π mov ah, 02hπ int 17h {int. 17h service 02h}π xor al, al {assume false}π and ah, 10101000b {clear all other bits}π cmp ah, 10000000b {ready & not out of paper or error?}π jne @Done {no -- leave result false}π inc ax {yes -- change to true}π@Done:πend;π---π * D.W.'s TOOLBOX, Atlanta GA, 404-471-6636π * PostLink(tm) v1.06 DWTOOLBOX (#1035) : RelayNet(tm)π 17 07-16-9306:12ALL GUY MCLOUGHLIN GREAT Printer Unit IMPORT 74 ε╡ π (* Insert a '.' before the statment '$DEFINE' to *)π (* compile without debugging information. *)π{.$DEFINE DebugMode}ππ{$IFDEF DebugMode}π {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P-,R+,S+,V+,X-}π{$ELSE}π {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,R-,S-,V-,X-}π{$ENDIF}ππ(**********************************************************************)π(* PRINTIT.PAS - Public-domain TP printer unit by Guy McLoughlin. *)π(* version 1.10 (July, 1993) *)π(* Min TP version: 4+ *)π(**********************************************************************)ππunit PrintIt;ππ(* BIT-MAP OF THE PRINTER "STATUS-BYTE" *)π(* ------------------------------------ *)π(* *)π(* BIT NUMBER 7 6 5 4 3 2 1 0 *)π(* | | | | | | | +-- Printer "timed-out" *)π(* | | | | | +--+----- These bits are NOT used *)π(* | | | | +----------- Printer I/O error *)π(* | | | +-------------- Printer "selected" *)π(* | | +----------------- Printer is out of paper *)π(* | +-------------------- Acknowlegment from printer *)π(* +----------------------- Printer NOT busy *)ππinterfaceππtypeπ st_8 = string[8];πππ (***** Initialize printer port. *)π (* *)π function InitPrinterPort({ input} wo_PrinterNum : word) : {output} byte;πππ (***** Check the status of the printer. *)π (* *)π function CheckPrinter({ input} wo_PrinterNum : word) : {output} byte;πππ (***** Initialize PrintIt variables, and check printer status. *)π (* *)π function InitPrintIt({ input} st_PrinterID : st_8;π by_PrinterNum : byte;π bo_InitPort : boolean;π {update} var fi_Printer : text;π var by_Status : byte)π {output} : boolean;πππ (***** Position printer "head" to X columns across, Y rows down. *)π (* *)π procedure P2xy({ input} var fi_Printer : text;π by_Xaxis,π by_Yaxis : byte);πππ (***** Print string at position X columns across, Y rows down. *)π (* *)π procedure Pwrite({ input} var fi_Printer : text;π st_Data : string;π by_Xaxis,π by_Yaxis : byte);πππimplementationππconst (* Line-feed, Carriage-return, Space character constant *)π co_Lf = #10;π co_Cr = #13;π co_Space = #32;ππvar (* "space" character, and line-feed string variables. *)π st_Spaces,π st_LineFeeds : string;πππ (***** Initialize printer port. *)π (* *)π function InitPrinterPort({ input} wo_PrinterNum : word) :π {output} byte; assembler;π asmπ mov ax, 0100hπ mov dx, wo_PrinterNumπ int 17hπ mov al, ahπ end; (* InitPrinterPort. *)πππ (***** Check the staus of the printer. *)π (* *)π function CheckPrinter({ input} wo_PrinterNum : word) :π {output} byte; assembler;π asmπ mov ax, 0200hπ mov dx, wo_PrinterNumπ int 17hπ mov al, ahπ end; (* CheckPrinter. *)πππ (***** Initialize PrintIt variables, and check printer status. *)π (* *)π function InitPrintIt({ input} st_PrinterID : st_8;π by_PrinterNum : byte;π bo_InitPort : boolean;π {update} var fi_Printer : text;π var by_Status : byte)π {output} : boolean;π beginπ (* Initialize "PrintIt" variables. *)π fillchar(st_Spaces, sizeof(st_Spaces), co_Space);π fillchar(st_LineFeeds, sizeof(st_LineFeeds), co_Lf);ππ (* Try to open text-device printer variable. *)π assign(fi_Printer, st_PrinterID);π {$I-}π rewrite(fi_Printer);π {$I+}π if (ioresult <> 0) thenπ beginπ by_Status := $FF;π InitPrintIt := falseπ endπ elseπ beginπ (* Initialize printer-port if required. *)π if bo_InitPort thenπ by_Status := InitPrinterPort(by_PrinterNum)π elseπ (* Else, check the status of the printer. *)π by_Status := CheckPrinter(by_PrinterNum);ππ (* Check for error-flags in the printer status byte. *)π if ((by_Status AND $29) = 0) thenπ InitPrintIt := trueπ elseπ InitPrintIt := falseπ endπ end; (* InitPrinter. *)πππ (***** Position printer "head" to X columns across, Y rows down. *)π (* *)π procedure P2xy({ input} var fi_Printer : text;π by_Xaxis,π by_Yaxis : byte);π beginπ if (by_Yaxis > 0) thenπ beginπ st_LineFeeds[0] := chr(by_Yaxis);π write(fi_Printer, st_LineFeeds)π end;π if (by_Xaxis > 0) thenπ beginπ st_Spaces[0] := chr(pred(by_Xaxis));π write(fi_Printer, co_Cr + st_Spaces)π endπ end; (* P2xy. *)πππ (***** Print string at position X columns across, Y rows down. *)π (* *)π procedure Pwrite({ input} var fi_Printer : text;π st_Data : string;π by_Xaxis,π by_Yaxis : byte);π beginπ P2xy(fi_Printer, by_Xaxis, by_Yaxis);π write(fi_Printer, st_Data)π end; (* Pwrite. *)ππEND.ππ{-------------------------------- CUT HERE -----------------------------}π(* Program to demo "PrintIt" unit. *)ππprogram DemoPrintIt;πusesπ PrintIt;ππconst (* Form-feed character. *)π co_FF = #12;ππvar (* Printer "status" byte. Check "bit-map" in PrintIt *)π (* unit for table of bit-flags. *)π by_PrinterStatus : byte;ππ (* Our text-device interface variable. *)π fi_Printer : text;ππ (* Main program block. *)πBEGINπ (* Initialize "PrintIt" variables, and check the *)π (* status of the printer. *)π if NOT InitPrintIt('PRN', 0, false, fi_Printer, by_PrinterStatus) thenππ (* InitPrintIt failed. Inform user of this, and halt. *)π beginπ writeln('Error accessing printer!');π writeln('Printer error = ', by_PrinterStatus);π haltπ end;π (* Print "SECRET" meaning of life symbol!!! <g> *)π (* Position printer head to column 45, 5 rows down. *)π P2xy(fi_Printer, 45, 5);ππ (* Write some text to the printer. *)π write(fi_Printer, '_)');ππ P2xy(fi_Printer, 43, 0);π write(fi_Printer, '(_');π P2xy(fi_Printer, 45, 1);π write(fi_Printer, '@)');π P2xy(fi_Printer, 43, 0);π write(fi_Printer, '(@');π P2xy(fi_Printer, 41, 1);π write(fi_Printer, '---\/');π P2xy(fi_Printer, 36, 0);π write(fi_Printer, '/----');π P2xy(fi_Printer, 35, 1);π write(fi_Printer, '/ | ||');π P2xy(fi_Printer, 40, 1);π write(fi_Printer, '---||');π P2xy(fi_Printer, 34, 0);π write(fi_Printer, '* ||-');π P2xy(fi_Printer, 37, 1);π write(fi_Printer, '^^ ^^');ππ (* Print "SECRET" number code, using "Pwrite" routine.*)π Pwrite(fi_Printer, '10', 45, 5);π Pwrite(fi_Printer, '2', 37, 0);π Pwrite(fi_Printer, '8', 43, 0);π Pwrite(fi_Printer, '7', 42, 0);π Pwrite(fi_Printer, '1', 36, 0);π Pwrite(fi_Printer, '6', 41, 0);π Pwrite(fi_Printer, '3', 38, 0);π Pwrite(fi_Printer, '9', 44, 0);π Pwrite(fi_Printer, '5', 40, 0);π Pwrite(fi_Printer, '0', 35, 0);π Pwrite(fi_Printer, '4', 39, 0);ππ (* Say good-bye, Guy. *)π Pwrite(fi_Printer, '...Thats All Folks!!!', 30, 2);ππ (* Send form-feed to printer. *)π write(fi_Printer, co_FF)πEND.ππ 18 07-16-9306:14ALL SWAG SUPPORT TEAM Print Spooler Interface IMPORT 12 ε╡ Program SPOOLIT;ππ{ Example program to demonstrate the PRINT spooler interface }ππ{ Define the data structure we need for spooling files }ππUses DOS;ππTypeππ SpoolRecType = Recordπ Priority : Byte;π Filename : Pointer;π end;ππVarππ SpoolFile : PathStr;π SpoolBuffer : Array[1..70] of char;π SpoolRec : SpoolRecType;π Regs : Registers;π SpooledOk : Boolean;ππBeginππ With Regs do beginπ AX := $100;π Intr($2F,Regs);π If AL = 0 then Beginπ WriteLn('PRINT is not loaded.');π Haltπ endπ end;ππ { Query user for the name of a file to spool }ππ Write('Enter the filename to print: ');π ReadLn(SpoolFile);ππ If Length(SpoolFile) = 0 then Halt; {Nothing to do, so quit}ππ FillChar(SpoolBuffer,SizeOf(SpoolBuffer),0);ππ Move(SpoolFile[1],SpoolBuffer,Length(SpoolFile));ππ SpoolRec.Priority := 0;π SpoolRec.Filename := Addr(SpoolBuffer);ππ { Send the file on its way }ππ With Regs do Beginπ AX := $101;π DS := DSeg;π DX := Ofs(SpoolRec);π Intr($2F,Regs);ππ { Isolate the status fo the spool operation }ππ SpooledOK := Not ((Flags and 1) = 1);ππ If SpooledOk thenπ WriteLn('Your file has been placed in the queue.')π elseπ WriteLn('Could not spool your file, error code is ',AL)π endππEnd. 19 08-17-9308:40ALL SWAG SUPPORT TEAM Checking For Printer IMPORT 13 ε╡ program chkprinter;ππuses dos,crt;ππvarπ lprn: integer;π st : string;πππfunction printerok(lprn : integer) : boolean;ππvar ok : boolean;π regs : registers;π st : string;π code : byte;ππbegin {printerok}π ok := false;π dec(lprn);π if ((lprn >= 0) and (lprn <= 2)) thenπ repeatπ regs.ah := 2;π regs.dx := lprn;π intr($17, regs);π code := regs.ah;π if code <> $90π thenπ beginπ case code ofπ $02, $4A : st := ' Printer is not connected ';π $00, $10,π $18, $58 : st := ' Printer is offline ';π $28, $38 : st := ' Printer is out of paper ';π $88, $C8 : st := ' Printer is turned off ';π else st := ' Output device is not ready ';π end; {case}π GoToXY(1,1);π WriteLn(st);π WriteLn(' ');π WriteLn('Please correct the error');π WriteLn('or press a key to continue')π endπ elseπ ok := true;π until ok or keypressed;π if ok then printerok := okπend; {printerok}π{**********************************************************************}ππ beginππ ClrScr;ππ if paramcount <> 0π then beginπ st := copy(paramstr(1), 1, 1);π lprn := ord(st[1]) - 48π endπ else lprn := 1;ππ if printerok(lprn) thenπ writeln('Printer OK')π elseπ writeln('Printer not ok')πend.π 20 08-17-9308:48ALL SWAG SUPPORT TEAM Printer Check Routines IMPORT 13 ε╡ PROGRAM PRINTCHK;ππuses crt,dos,printer;πconstπ lpt1=0;π lpt2=1;π lpt3=2;ππ PrnReady = $90;π OffLine = $00;π OffLine2 = $10; {NEW LINE}π PaperOut = $20;π PaperOut2 = $30; {NEW LINE}π HookedButOff = $80; {NEW LINE}π NoConnect = $B0; {MODIFIED LINE}ππ {NOCONNECT = $30 FOR SOME COMPUTERS BY STU}ππ Function ChkPrinter(Printer:Word) :Word;π Var Regs:Registers;ππ Beginπ Regs.AH:=2;π Regs.DX:=Printer;π Intr($17,regs);π ChkPrinter:=Regs.AHπ end;ππ Procedure PrinterError(ErrorCode:BYTE); ;NEWπππ VARπ C : BYTE;ππππ Beginπ ErrorCode := ErrorCode and $B0; {NEW LINE}ππ C := ERRORCODE SHL 6 {ALWAYS MEANS NOTHING CONNECTED}ππ IF C > 0 THEN ERRORCODE = $B0; {ELEMINATES NO LPT3 AND NOTHING CONNECTED}πππ Case ErrorCode ofπ NoConnect : WriteLn('Printer not connected');π Offline,OffLine2 : WriteLn('Printer off line'); {Modified}π PaperOut,PaperOut2 : WriteLn('Printer out of paper'); {Modified}π HookedButOff : WriteLn('Printer connected but turned off'); {New}π elseπ WriteLn('Printer error code: ',ErrorCode);π endπ end;ππ procedure TryPrinter;π Beginπ {$I-}π WriteLn(Lst,'Check Printer'+#12);π {$I+}π WriteLn(IOResult)π End;ππ Beginπ ClrScr;π {TryPrinter;}π If ChkPrinter(LPT1) = PrnReady thenπ Writeln('Printer is Ready')π elseπ PrinterError(ChkPrinter(LPT1))π end. 21 08-18-9312:28ALL JOSE ALMEIDA Base address - parallel IMPORT 9 ε╡ { Base address for four parallel ports.π Part of the Heartware Toolkit v2.00 (HTparal.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Parallel_Base_Addr(LPT_Port : byte) : word;π{ DESCRIPTION:π Base address for four parallel ports.π SAMPLE CALL:π NW := Parallel_Base_Addr(1);π RETURNS:π The base address for the specified parallel port.π NOTES:π If the port is not used, then the returned value will be 0 (zero).π The aceptable values for LPT_Port are: 1,2,3 and 4. }ππBEGIN { Parallel_Base_Addr }π Parallel_Base_Addr := MemW[$0000:$0408 + Pred(LPT_Port) * 2];πEND; { Parallel_Base_Addr }π 22 08-18-9312:28ALL JOSE ALMEIDA Number of parallel ports IMPORT 7 ε╡ { Number of parallel ports installed in the system.π Part of the Heartware Toolkit v2.00 (HTparal.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Parallel_Ports : byte;π{ DESCRIPTION:π Number of parallel ports installed in the system.π SAMPLE CALL:π NB := Parallel_Ports; }ππBEGIN { Parallel_Ports }π Parallel_Ports := MemW[$0000:$0410] shr 14;πEND; { Parallel_Ports }π 23 08-18-9312:29ALL JOSE ALMEIDA Time-Out values IMPORT 7 ε╡ { Time-Out values for parallel printers.π Part of the Heartware Toolkit v2.00 (HTparal.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Parallel_Time_Out(LPT : byte) : byte;π{ DESCRIPTION:π Time-Out values for parallel printers.π SAMPLE CALL:π NB := Parallel_Time_Out(1);π NOTES:π The allowed values for LPT are: 1,2,3 or 4. }ππBEGIN { Parallel_Time_Out }π Parallel_Time_Out := Mem[$0000:$0478 + Pred(LPT)];πEND; { Parallel_Time_Out }π 24 08-27-9321:46ALL JACK WILSON Object printer IMPORT 26 ε╡ {πJack WilsonππThe Objective is to intercept when the Printer is off-line, and give theπuser a reminder to turn the Printer on-line, and press any key to resumeπprinting.ππI Realize this is most certainly an FAQ, and I have found some sourceπcode on Timo's site For TP 5.5 that I have modified (see below), butπthere is not much talk anymore about TP 3.0.ππAnyway, to avoid making a lot of changes to my source code, I thought Iπwould reWrite the LstOut Procedure (which according to the manual, isπcalled by routines accessing the LST: device) as shown at the end ofπthe following listing. This is inefficient, since it is being calledπfor each Character that is output to the Printer. Does anybody have aπbetter suggestion? I might add the way it is now, if an off-lineπsignal is detected, the LstOut will only print the first Characterπ('t') in the Write(lst,'test') in the main Program, With the 'est'πgoing to the screen. if I remove the statements in the While loop ofπLstOut, then all of 'test' goes to the Printer, but it defeats myπpurpose of giving the user a message.π}ππ{by David R. Conrad, For Turbo Pascal 5.5ππ This code is not copyrighted, you may use it freely.π There are no guarantees, either expressed or implied,π as to either merchantability or fitness For a particularπ purpose. The author's liability is limited to the amountπ you paid For it.π David R. Conrad, 17 Nov 92π David_Conrad@mts.cc.wayne.eduπ dave@michigan.comπ}ππConstπ { For use With the Printer Functions }π PrnNotBusy = $80;π PrnAck = $40;π PrnNoPaper = $20;π PrnSelect = $10;π PrnIOError = $08;π PrnTimeout = $01;ππTypeπ Word = Integer;π AnyStr = String[255];ππVarπ PrinterNumber : Byte;ππ{ all routines are documented in the Implementation section }ππProcedure InitRegisters(Var Reg : Registers);π{ initialize Variable of Type Registers: slightly anal-retentive }πbeginπ fillChar (Reg, sizeof(Reg), 0);π Reg.DS := DSeg;π Reg.ES := DSeg;πend;ππFunction PrnOnline(Printernumber : Byte) : Boolean;π{ Is LPT(Printernumber) online? }πVarπ Reg : Registers;πbeginπ InitRegisters(Reg);π Reg.AH := 2;π Reg.DX := Pred(Printernumber);π Intr($17, Reg);π PrnOnline := (Reg.AH and PrnSelect) = PrnSelect;πend;ππProcedure pause;πVarπ c : Char;ππbeginπ c := #127;π Repeatπ if KeyPressed thenπ c := ReadKey;π Until c in [#0..#126];πend;πππ{**************************************************************************}π{THIS IS THE ROUTINE in QUESTION}ππProcedure LstOut(ch : Char);ππVarπ Reg : Registers;ππbeginπ While not (PrnOnline(PrinterNumber)) doπ beginπ {if I TAKE OUT THESE NEXT THREE LINES, then OUTPUT PaUses Until Printerπ IS ON-LINE, and then ALL CharS PRINT to Printer}π GotoXY(1, 23);π ClrEol;π Write('Please check Printer, and press any key when ready...');π pause;π end;π initRegisters(Reg);π Reg.AH := 0;π Reg.DX := Pred(PrinterNumber);π Reg.AL := Byte(ch);π Intr($17, Reg);ππend;ππ{**************************************************************************}ππbeginπ PrinterNumber := 1;π LstOutPtr := ofs(LstOut);π Writeln(lst, 'test');πend.ππ 25 11-02-9305:47ALL JAN BARENDREGT Graphics Dump to Laser SWAG9311 22 ε╡ {π> I wrote a computer Program that produces 8 bit 480 x 640 hi res images,π> and I would like to know if anyone is familiar With a routine that canπ> print these images out on a Printer.π> The preferable Printer For the task is a HP LaserJet II.π>π> I would like to be able to tell the LaserJet exactly which pixel dotsπ> to print, and I don't mind if I have to give bit information to theπ> Printer line-by-line.π>ππBelow is some (old) code to make a screendump in Graphics mode, forπboth HP laser II and Epson. I haven't tested this For SVGA, but ifπyou give MaxX and MaxY the right values, I can't see where it wouldπgo wrong.ππJan Barendregtπ}πUsesπ Graph,π Dos,π Printer;ππConstπ d = 'l';ππVarπ MaxX, MaxY : Integer;ππProcedure dump;πVarπ ymax,π bbyt,π b2 : Byte;π psf : File of Byte;π regs : Registers;ππ Procedure out(ch : Char);π beginπ regs.ax := ord(ch);π regs.dx := 0;π intr($17, regs);π end;ππ Procedure hplaser;π Varπ b,π reg,π kol : Word;π beginπ assign(psf, 'lpt1');π reWrite(psf);π Write(lst, chr(27), 'E');π Write(lst, chr(27), '*t100R', chr(27), '*r0A');π For reg := 0 to maxx doπ beginπ Write(lst, chr(27), '*b', (maxy + 1) div 8, 'W');π For kol := ((maxy + 1) div 8) - 1 downto 0 doπ beginπ bbyt := 0;π For b := 0 to 7 doπ beginπ if getpixel(reg, kol * 8 + b) = 0 thenπ b2 := 0π elseπ b2 := 1;π bbyt := bbyt or (b2 shl b);π end;π out(chr(bbyt));π end;π end;π Write(lst, chr(27), '*rB');π Write(lst, chr(12));π Write(lst, chr(27), 'E');π close(psf);π end;ππ Procedure epson;π Varπ k, j, i : Byte;ππ Function xget(x, y : Integer) : Byte;π beginπ regs.ah := $0D;π regs.cx := x;π regs.dx := y;π intr(16, regs);π xget := regs.al;π end;ππ beginπ out(chr($1B));π out(chr($33));π out(chr($18));π out(chr($0D));π out(chr($0A));π For j := 0 to (maxy shr 3) doπ beginπ out(chr($1B));π out(chr($4C));π out(chr((maxx + 1) mod 256));π out(chr((maxx + 1) div 256));π For i := 0 to maxx doπ beginπ bbyt := 0;π For k := 0 to 7 doπ if (xget(i, (j shl 3) + k) <> 0) thenπ bbyt := bbyt or (128 shr k);π out(chr(bbyt));π end;π out(chr(13));π out(chr(10));π end;π end;ππbeginπ MaxX := GetMaxX;π MaxY := GetMaxY;ππ if d = 'l' thenπ hplaserπ elseπ epson;πend;πππVarπ Gd, Gm,π Radius : Integer;ππbeginπ Gd := Detect;π InitGraph(Gd, Gm, 'e:\bp\bgi');π For Radius := 1 to 5 doπ Circle(100, 100, Radius * 10);π Readln;π Dump;π CloseGraph;πend.π 26 11-21-9309:45ALL PHIL NICKELL PrintUsing in PASCAL SWAG9311 16 ε╡ {πFrom: PHIL NICKELLπSubj: Basic PrintUsing in PASπDoes anyone know of any shareware or freeware routines in Turbo Pascalπ5.5, that will allow me to format numbers or strings like the PRINTUSINGπstatement in BASIC???π}ππ PROCEDURE printusing (mask: string; value:real);π { Calling syntax = PRINTUSING(mask, number)π mask can be a string label or a literalπ Example printusing('#,###,###',45.63);π printusing('######.###,value); }π constπ comma : char = ',';π point : char = '.';π minussign : char = '-';π varπ fieldwidth, integerlength, i, j, places, pointposition: integer;π usingcommas, decimal, negative : boolean;π outstring, integerstring : string;ππ beginπ negative := ( value < 0 );π value := abs( value );π places := 0;π fieldwidth := length( mask );π usingcommas := ( pos ( comma, mask ) > 0 );π decimal := ( pos (point,mask) > 0 );π if decimal thenπ beginπ pointposition := pos(point, mask);π places := fieldwidth - pointposition;π END;π str ( value:0:places, outstring );π if usingcommas thenπ beginπ J := 0;π integerstring :=π copy (outstring, 1, length(outstring)-places);π integerlength := length(integerstring);π if decimal thenπ integerlength := pred(integerlength);π for i := integerlength downto 2 doπ beginπ inc(j);π if j mod 3 = 0 thenπ insert (comma,outstring,i);π end;π end;π if negative thenπ outstring := minussign + outstring;π write( outstring:fieldwidth);π END; {PRINTUSING}ππBEGINπPrintUsing('##,###,###.##',123456.78);πEND. 27 11-02-9310:33ALL RANDALL WOODMAN PRINTER Handler SWAG9311 39 ε╡ {πRANDALL WOODMANππNOTE: There is a call to a Procedure called YNWin. It is defined as:π YNWin(s : String; Var ch : Char; Color : ColorSet);πColor set comes from the ObjectProfessional package from TurboPower software.πYNWin is derived from one of their Objects. Basically it pops up a Window,πdisplays the String, s, in the colors specified, and waits For a Y or N Charπfrom the user. It returns that result in CH.π I did not include YNWin in this post. However, you can easily Writeπa Procedure to take it's place. I only left the calls in place to show youπwhat I do when I do need interaction from the user.π The Printer codes used are specific to an Epson compatible Printer.πCheck your user manual For other Printer support.π}ππUnit IThinkClintonsDefecetReductionPackageSucks;ππUsesπ Dos;ππConstπ TimedOut = $01; { Used to determine the Type of Printer error }π IOError = $08;π OutOfPaper = $20;π NotBusy = $80;π TestAll = TimedOut+IOError+OutOfPaper;ππVarπ PrnStatus : Byte;ππFunction PrinterReady : Boolean;π{ checks the status of the Printer and returns True if ready }π{ to recieve a Character }π{ This Function will return the status of your Printer. Status }π{ should be interpreted as follows: (x'90' (d'144') is "Ready"): }π{ $01 = Printer Time-out $02 = Not Used }π{ $04 = Not Used $08 = I/O Error }π{ $10 = Printer Selected $20 = Out Of Paper }π{ $40 = Acknowledge $80 = Not Busy }ππVarπ Regs : Registers;π TempStatus : Byte;πbeginπ With Regs Doπ beginπ DX := 0;π AX := $0200;π Intr($17,Regs);π PrnStatus := Hi(AX);π TempStatus := PrnStatus;π PrinterReady := (TempStatus and TestAll = $00);π end;πend;ππProcedure GetPrnError(Var ESC : Boolean);π{ gets the error that occured With the Printer and gives the user a chance to }π{ correct the problem and continue. }πVarπ CH : Char;πbeginπ Repeatπ PrnStatus := PrnStatus and TestAll;π Case PRnStatus OFπ TimedOut : YNWin('Printer timed out. Retry??? (Y/N)',Ch,Mycolor);π IOError : YNWin('An IOError has occured. Retry??? (Y/N)',CH,Mycolor);π OutOfPaper : YNWin('Printer out of paper. Retry??? (Y/N)',CH,Mycolor);π elseπ YNWin('A Print Device Error has occured. Retry??? (Y/N)',CH,Mycolor);π end; { Case }π if CH = 'N' thenπ esc := True;π Until ESC or PrinterReady;πend;ππFunction EscapePushed : Boolean;π{ Checks the keyboard buffer For a Character and test to see if it was the }π{ Esc key. if it was it returns True else it returns False. }πVarπ CH : Char;πbeginπ if KeyPressed then { Check the keyboard buffer For a Character }π beginπ CH := ReadKey; { if Character then check it }π CH := UpCase(CH);π EscapePushed := (Ch = Chr(27));π endπ elseπ EscapePushed := False;πend;ππProcedure ConfirmQuit(Var ESC : Boolean);π{ confirms that the user wants to quit printing }πVarπ CH : Char;πbeginπ YNWin('Cancel all print jobs? (Y/N)',Ch,Mycolor);π ESC := (CH = 'Y');πend;ππProcedure PrintCh(CH : Char; Underline : Boolean; Var OK : Boolean);π{ Writes a single Character to the Printer }πbeginπ if UnderLine thenπ {$I-} Write(LST, #27#45#1, CH, #27#45#0) {$I+}π elseπ {$I-} Write(lst,CH); {$I+}π OK := (IOResult = 0);πend;ππProcedure MakeLine(Start, Stop : Integer; Return : Boolean; Var ESC : Boolean);π{ Draws a line on the paper starting at Start and ending at Stop. }πVarπ PrnReady,π Ok : Boolean;πbeginπ PrnReady := True;π Repeatπ PrnReady := PrinterReady;π if not PRnReady thenπ GetPrnError(ESC);π Until PrnReady or ESC;ππ PrnReady := True;π While prnReady and not Esc and (Start <> Stop + 1) DOπ beginπ prnReady := PrinterReady; { do three test to be sure }π if not PRnReady thenπ GetPrnError(ESC);π if not ESC thenπ PrintCH('_',False,OK);π if not ESC thenπ if EscapePushed thenπ ConfirmQuit(ESC);π if OK thenπ Inc(Start);π end;π if not Esc and PrnReady and RETURN thenπ {$I-} Writeln(LST); {$I+}πend;ππProcedure WriteStr(TheStr : String; Return, UnderLine : Boolean;π Var ESC : Boolean);πVarπ PrnReady,π OK : Boolean;π I : Byte;πbeginπ Repeatπ PrnReady := PrinterReady;π if not PRnReady thenπ GetPrnError(ESC);π Until PrnReady or ESC;π I := 1;ππ While PrnReady and not Esc and (I <> Length(theStr)+1) DOπ beginπ PrnReady := PrinterReady;π if not PRnReady thenπ GetPrnError(ESC);π if not ESC thenπ PrintCh(theStr[I], UnderLine, OK);π if not esc thenπ if EscapePushed thenπ confirmQuit(Esc);π if OK thenπ Inc(I);π end;π if PrnReady and Not ESC And RETURN thenπ {$I-} Writeln(LST); {$I+}πend;π 28 11-26-9317:38ALL SWAG SUPPORT GROUP PRINTER Unit Replacement SWAG9311 58 ε╡ { Can be used as a TOTAL replacement for the PRINTER UNIT }π{ You'll need to replace the PRINTER unit in the TURBO.TPL to use this }π{$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π{$F+,O-,X+,A-}π{$ENDIF}ππ{$DEFINE AssignLstDevice}π{$DEFINE DoErrorChecking} { undefine this to eliminate error checking }ππUNIT Printer;ππINTERFACEππ{$IFDEF DoErrorChecking}πUSES CRT;π{$ENDIF}ππCONSTππ fmClosed = $D7B0; { magic numbers for Turbo }π fmInput = $D7B1;π fmOutput = $D782;π fmInOut = $D7B3;ππ IO_Invalid = $FC; { invalid operation eg. attempt to write }π { to a file opened in fmInput mode }ππ LPTNames : ARRAY [0..2] OF STRING [4] = ('LPT1', 'LPT2', 'LPT3');ππ LPTPort : BYTE = 0;ππVARπ Lst : TEXT; { for source compatability with TP3 }ππFUNCTION GetROMPrinterStatus (LPTNo : WORD) : BYTE;π { status of LPTNo via ROM BIOS int 17h func 2h }π INLINE (π $5A / { pop DX ; get printer number}π $B4 / $02 / { mov AH,02 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππFUNCTION DoInt17 (Ch : CHAR; LPTNo : WORD) : BYTE;π { send a character to LPTNo via ROM BIOS int 17h func 0h }π INLINE (π $5A / { pop DX ; get printer number}π $58 / { pop AX ; get char}π $B4 / $00 / { mov AH,00 ; set AH for BIOS int 17h function 0}π $CD / $17 / { int $17 ; do an int 17h}π $86 / $E0); { xchg AL,AH ; put byte result in AL}ππPROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππPROCEDURE OutputToFile (FName : STRING);π {redirect printer output to file }ππFUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;ππFUNCTION Printer_OK : BOOLEAN;ππPROCEDURE SelectPrinter (LPTNum : BYTE);ππPROCEDURE ResetPrinter; { only resets printer 0 }ππIMPLEMENTATIONππTYPEπ TextBuffer = ARRAY [0..127] OF CHAR;ππ TextRec = RECORDπ Handle : WORD;π Mode : WORD;π BufSize : WORD;π Private : WORD;π BufPos : WORD;π BufEnd : WORD;π BufPtr : ^TextBuffer;π OpenFunc : POINTER;π InOutFunc : POINTER;π FlushFunc : POINTER;π CloseFunc : POINTER;π { 16 byte user data area, I use 4 bytes }π PrintMode : WORD; { not currently used}π LPTNo : WORD; { LPT number in [0..2] }π UserData : ARRAY [1..12] OF CHAR;π Name : ARRAY [0..79] OF CHAR;π Buffer : TextBuffer;π END;πCONSTπ LPTFileopen : BOOLEAN = FALSE;ππVARπ LPTExitSave : POINTER;ππ PROCEDURE Out_Char (Ch : CHAR; LPTNo : WORD; VAR ErrorCode : INTEGER);π { call macro to send char to LPTNo. If bit 4, the Printer Selected bit }π { is not set upon return, it is assumed that an error has occurred. }ππ BEGINπ ErrorCode := DoInt17 (Ch, LPTNo);π IF (ErrorCode AND $10) = $10 THEN { if bit 4 is set }π ErrorCode := 0 { no error }π { if bit 4 is not set, error is passed untouched and placed in IOResult }π END;ππ FUNCTION LstIgnore (VAR F : TextRec) : INTEGER;π { A do nothing, no error routine }π BEGINπ LstIgnore := 0 { return 0 for IOResult }π END;ππ FUNCTION LstOutput (VAR F : TextRec) : INTEGER;π { Send whatever has accumulated in the Buffer to int 17h }π { If error occurs, return in IOResult. See Inside Turbo }π { Pascal chapter of TP4 manual for more info on TFDD }π VARπ I : WORD;π ErrorCode : INTEGER;ππ BEGINπ LstOutput := 0;ππ {$IFDEF DOERRORCHECKING}π WHILE NOT Printer_OK DOπ BEGINπ GotoXY(1,23);ClrEol;π Write('Please check Printer, and press any key when ready...');π Readkey;π END;π {$ENDIF}ππ WITH F DO BEGINπ FOR I := 0 TO PRED (BufPos) DOπ BEGINπ Out_Char (BufPtr^ [I], LPTNo, ErrorCode); { send each char to printer }π IF ErrorCode <> 0 THEN BEGIN { if error }π LstOutput := ErrorCode; { return errorcode in IOResult }π EXIT { return from function }π ENDπ END;π BufPos := 0π END;π END;ππ PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);π { like Turbo's assign, except associates Text variable with one of the LPTs }ππ BEGINπ WITH TextRec (F) DOπ BEGINπ Mode := fmClosed;π BufSize := SIZEOF (Buffer);π BufPtr := @Buffer;π OpenFunc := @LstIgnore; { you don't open the BIOS printer functions }π CloseFunc := @LstIgnore; { nor do you close them }π InOutFunc := @LstOutput; { but you can Write to them }π FlushFunc := @LstOutput; { and you can WriteLn to them }π LPTNo := LPTNumber; { user selected printer num (in [0..2]) }π MOVE (LPTNames [LPTNumber], Name, 4); { set name of device }π BufPos := 0; { reset BufPos }π END;π END;ππ PROCEDURE OutputToFile (FName : STRING);π BEGINπ ASSIGN (Lst, FName);π REWRITE (Lst);π LPTFileopen := TRUE;π END;ππ FUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;π VARπ Status : BYTE;π BEGINπ Status := GetROMPrinterStatus (LPTNum);π IF (Status AND $B8) = $90 THENπ PrinterStatus := 0 {all's well}π ELSE IF (Status AND $20) = $20 THENπ PrinterStatus := 1 {no Paper}π ELSE IF (Status AND $10) = $00 THENπ PrinterStatus := 2 {off line}π ELSE IF (Status AND $80) = $00 THENπ PrinterStatus := 3 {busy}π ELSE IF (Status AND $08) = $08 THENπ PrinterStatus := 4; {undetermined error}π END;ππ FUNCTION Printer_OK : BOOLEAN;π VARπ Retry : BYTE;π BEGINπ Retry := 0;π WHILE (PrinterStatus (LPTPort) <> 0) AND (Retry < 255) DO INC (Retry);π Printer_OK := (PrinterStatus (LPTPort) = 0);π END; {PrinterReady}ππ PROCEDURE SelectPrinter (LPTNum : BYTE);π BEGINπ IF (LPTNum >= 0) AND (LPTNum <= 3) THENπ LPTPort := LPTNum;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);π END;ππ PROCEDURE ResetPrinter;π VARπ address : INTEGER ABSOLUTE $0040 : $0008;π portno, DELAY : INTEGER;π BEGINπ portno := address + 2;π Port [portno] := 232;π FOR DELAY := 1 TO 2000 DO {nothing} ;π Port [portno] := 236;π END; {ResetPrinter}ππ PROCEDURE LptExitHandler; FAR;π BEGINπ IF LPTFileopen THEN CLOSE (Lst);π ExitProc := LPTExitSave;π END;ππBEGINππ LPTExitSave := ExitProc;π ExitProc := @LptExitHandler;ππ {$IFDEF AssignLstDevice}ππ LPTPort := 0;π AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }π REWRITE (Lst);ππ {$ENDIF}ππ {$IFDEF DOERRORCHECKING}π WHILE NOT Printer_OK DOπ BEGINπ GotoXY(1,23);ClrEol;π Write('Please check Printer, and press any key when ready...');π Readkey;π END;π {$ENDIF}ππEND.π
